Amiga News 95/Amiga News 95.iso/dpat/dpat96/klondike_adptools_v1.1/datas/french.lha/2-MakeGlobalPalette.adpro

Text File | 1995-04-17 | 9KB | 397 lines

/*
** MakeGlobalPalette.adpro
**  This ARexx script for ADPro v2.5 or higher load some selected pictures
**  (IFF ILBM 24Bits, 86x128) selected by user, render then in a big backdrop
**  picture, and finally save the resultant palette.
**
** $VER: MakeGlobalPalette/French v1.1 (06.04.95) © Copyright Lejardinier Olivier - All rights reserverd
**
*/

 ADDRESS "ADPro"
 OPTIONS RESULTS

 NL = '0A'X
 FALSE = 0
 TRUE = 1

/*
** Save the current environment.
*/

 TempDefaults = "T:TempADProDefaults"
 SAVE_DEFAULTS TempDefaults

/*
** Initializations.
*/

 CLOSE_RENDER_SCREEN
 CLEAR_RENDERED
 CLEAR_RAW
 PSTATUS "UNLOCKED"
 ADPRO_TO_FRONT

 MemoryError = "Peut-être qu'il n'y a pas assez de mémoire."
 FileMemError = "Peut-être que le fichier est corrompu," || NL || "ou qu'il n'y a pas assez de mémoire."
 DiskSpaceError = "Peut-être qu'il n'y a pas assez d'espace disque de libre."

/*
** Get some cards files.
*/

 Continue = FALSE
 DO UNTIL ( Continue = TRUE )
  GETFILES '"Sélectionner 4 ou + de fichiers :"'
  IF ( RC ~= 0 ) THEN
   DO
    OKAYN '"Erreur :"' '"Vous DEVEZ sélectionner des fichiers !"' '"Sélectionner|Annuler"'
    IF ( RC = 0 ) THEN
     CALL ForceExit
   END
  ELSE
   DO
    CardsFiles = ADPRO_RESULT
    NbCards = WORDS( CardsFiles )
    IF ( NbCards < 4 ) THEN
     DO
      OKAYN '"Erreur :"' '"Vous DEVEZ sélectionner au moins 4 cartes !"' '"Sélectionner|Annuler"'
      IF ( RC = 0 ) THEN
       CALL ForceExit
     END
    ELSE
     Continue = TRUE
   END
 END

/*
** Create backdrop.
*/

 Max = WORDS( CardsFiles ) % 4
 Curr = Max
 LOAD_TYPE "REPLACE"

 Continue = FALSE
 DO UNTIL (( Continue = TRUE ) | ( Curr = 0 ))
  LOADER "BACKDROP" "XXX" "WIDTH" 4*88 "HEIGHT" Curr*130 "COLOR"
  IF ( RC ~= 0) THEN
   Curr = Curr - 1
  ELSE
   Continue = TRUE
 END

 IF ( Curr = 0 ) THEN
  DO
   Text = "Erreur : Pas assez de mémoire pour calculer la palette globale..."
   OKAYN '"Erreur :"' '"'Text'"' '"Quitter"'
   CALL ForceExit
  END
 ELSE
  DO
   Continue0 = FALSE
   Continue = FALSE
   DO UNTIL ( Continue0 = TRUE )
    DO UNTIL ( Continue = TRUE )
     Text = "Nombre de cartes utilisées pour le rendu ? (" || Curr || "x4=" || Curr*4 || ") :"
     GETNUMBER '"'Text'"' Curr 1 Max
     IF ( RC ~= 0 ) THEN
      DO
       Text = "Ok pour utiliser" Curr || "x4=" || Curr*4 "cartes ?"
       OKAYN '"Confirmer :"' '"'Text'"' '"Ok|Sélectionner|Annuler"'
       IF ( RC = 0 ) THEN
        CALL ForceExit
       ELSE
        IF ( RC = 1 ) THEN
         Continue = TRUE
      END
     ELSE
      DO
       Curr = ADPRO_RESULT
       Continue = TRUE
      END
    END

    LOAD_TYPE "REPLACE"
    LOADER "BACKDROP" "XXX" "WIDTH" 4*88 "HEIGHT" Curr*130 "COLOR"
    IF ( RC ~= 0) THEN
     DO
      Text = "Impossible de créer le backdrop." || NL || MemoryError
      OKAYN '"Erreur :"' '"'Text'"' '"Réessayer|Annuler"'
      IF ( RC = 0 ) THEN
       CALL ForceExit
     END
    ELSE
     DO
      Max = Curr
      Continue0 = TRUE
     END
   END
  END

/*
** Compose all Sélectionnered cards files.
*/

 X = 0
 Y = 0
 NbCards = Max * 4
 Index = 1
 Counter = 0
 LOAD_TYPE "COMPOSE"

 DO WHILE ( Index <= NbCards )

  Continue = FALSE
  DO UNTIL ( Continue = TRUE )
   Cardname = WORD( CardsFiles , Index )
   LOADER "IFF" Cardname X+1 Y+1 100 -1 -1 -1
   IF ( RC ~= 0 ) THEN
    DO
     Text = "Impossible de charger :" || NL || STRIP( Cardname , B , '"' ) || NL || FileMemError
     OKAYN '"Erreur :"' '"'Text'"' '"Réessayer|Passer|Annuler"'
     IF ( RC = 0 ) THEN
      CALL ForceExit
     ELSE
      IF ( RC = 2 ) THEN
       DO
        Index = Index + 1
        IF ( Index > NbCards ) THEN
         DO
          IF ( Counter = 0 ) THEN
           DO
            Text = "Impossible de calculer la palette globale :" || NL || "Aucune images n'a été chargées !"
            OKAYN '"Erreur :"' '"'Text'"' '"Quitter"'
            CALL ForceExit
           END
          ELSE
           DO
            Text = "Il n'y a plus de cartes à charger... " || NL || "Voulez-vous calculer la palette globale avec les" || NL || Counter "images précédement chargées ?"
            OKAYN '"Requète :"' '"'Text'"' '"Oui|Quitter"'
            IF ( RC = 0 ) THEN
             CALL ForceExit
           END
         END
       END
    END
   ELSE
    DO
     Continue = TRUE
     Index = Index + 1
     Counter = Counter + 1
    END
  END

  X = X + 88
  IF ( X = 4*88) THEN
   DO
    X = 0
    Y = Y + 130
   END
 END

/*
** Render all cards files.
*/

 SET_RENDER_MODE Amiga 167940 4*88 Max*130 HAM8
 DITHER 1

 Continue = FALSE
 DO UNTIL ( Continue = TRUE )
  EXECUTE
  IF ( RC ~= 0 ) THEN
   DO
    Text = "Impossible de créer l'image finale." || NL || MemoryError
    OKAYN '"Erreur :"' '"'Text'"' '"Réessayer|Annuler"'
    IF ( RC = 0 ) THEN
     CALL ForceExit
   END
  ELSE
   Continue = TRUE
 END

/*
** Modify palette file.
*/

 Text = "Voulez-vous utiliser la couleur de fond par DEFAUT ou CUSTOM ?"
 OKAYN '"Requète :"' '"'Text'"' '"Default|Annuler|Custom"'
 IF ( RC = 2 ) THEN
  CALL ForceExit
 ELSE
  IF ( RC = 1 ) THEN
   PPOKE 0 56 101 121
 ELSE
  DO
   Text = "Sélectionner la composante ROUGE :"
   GETNUMBER '"'Text'"' 56 0 255
    IF ( RC ~= 0 ) THEN
     Red0 = 56
    ELSE
     Red0 = ADPRO_RESULT
   Text = "Sélectionner la composante VERTE :"
   GETNUMBER '"'Text'"' 101 0 255
    IF ( RC ~= 0 ) THEN
     Green0 = 101
    ELSE
     Green0 = ADPRO_RESULT
   Text = "Sélectionner la composante BLEUE :"
   GETNUMBER '"'Text'"' 121 0 255
    IF ( RC ~= 0 ) THEN
     Blue0 = 121
    ELSE
     Blue0 = ADPRO_RESULT
   PPOKE 0 Red0 Green0 Blue0
  END

 PPOKE 1 255 0 0
 PPOKE 2 255 255 255
 PPOKE 3 0 0 0
 PPOKE 20 255 0 0
 PPOKE 24 255 0 0

/*
** Save palette file.
*/

 DestDir = WORD( CardsFiles , 1 )
 FirstChar = LEFT( DestDir , 1 )
 IF ( (FirstChar = '"') | (FirstChar = '''') ) THEN
  DestDir = STRIP( DestDir, "B" , FirstChar )

 FNameSepPos = LASTPOS( '/' , DestDir )
 IF (FNameSepPos = 0) THEN
  FNameSepPos = LASTPOS( ':' , DestDir )

 IF (FNameSepPos ~= 0) THEN
  DO
   Basename = RIGHT( DestDir , LENGTH( DestDir ) - FNameSepPos )
   DestDir = LEFT( DestDir , FNameSepPos )
   IF ( LASTPOS( '.'  , Basename ) ~= 0 ) THEN
    Basename = DELSTR( Basename , LASTPOS( '.'  , Basename ) )
  END
 ELSE
  DO
   DestDir = ""
   Basename = "Cards"
  END

 Palettename = Basename || ".Palette"
 Continue = FALSE
 DO UNTIL ( Continue = TRUE )
  GETFILE '"Sélectionner le nom de la palette :"' '"'DestDir'"' '"'Palettename'"'
  IF ( RC ~= 0 ) THEN
   DO
    Text = "Utiliser" Palettename "comme nom de palette ?"
    OKAYN '"Confirmer :"' '"'Text'"' '"Utiliser|Sélectionner|Annuler"'
    IF ( RC = 0 ) THEN
     CALL ForceExit
    ELSE
     IF ( RC = 1 ) THEN
      DO
       Palettename = DestDir || Palettename
       Continue = TRUE
      END
   END
  ELSE
   DO
    Palettename = ADPRO_RESULT
    Continue = TRUE
   END
 END

 Continue = FALSE
 DO UNTIL ( Continue = TRUE )
  PSAVE Palettename
  IF ( RC ~= 0 ) THEN
   DO
    Text = "Impossible de sauver la palette :" || NL || STRIP( Palettename , B , '"' ) || NL || DiskSpaceError
    OKAYN '"Erreur :"' '"'Text'"' '"Réessayer|Annuler"'
    IF ( RC = 0 ) THEN
     CALL ForceExit
   END
  ELSE
   Continue = TRUE
 END

/*
** Save preview.
*/

 OKAYN '"Requète :"' '"Voulez-vous sauver la preview ?"' '"Sauver|Quitter"'
 IF ( RC = 1 ) THEN
  DO
   CLOSE_RENDER_SCREEN
   CLEAR_RENDERED
   PSTATUS "UNLOCKED"
   EXECUTE
   IF ( RC ~= 0 ) THEN
    DO
     Text = "Impossible de créer la preview..."
     OKAYN '"Erreur :"' '"'Text'"' '"Quitter"'
     CALL ForceExit
    END
   ELSE
    DO
     Previewname = Basename || "_Preview.HAM8"
     Continue = FALSE
     DO UNTIL ( Continue = TRUE )
      GETFILE '"Sélectionner le nom de la preview :"' '"'DestDir'"' '"'Previewname'"'
      IF ( RC ~= 0 ) THEN
       DO
        Text = "Utiliser" Previewname "comme nom pour la preview ?"
        OKAYN '"Confirmer :"' '"'Text'"' '"Utiliser|Sélectionner|Annuler"'
        IF ( RC = 0 ) THEN
         CALL ForceExit
        ELSE
         IF ( RC = 1 ) THEN
          DO
           Previewname = DestDir || Previewname
           Continue = TRUE
          END
       END
      ELSE
       DO
        Previewname = ADPRO_RESULT
        Continue = TRUE
       END
     END

     Continue = FALSE
     DO UNTIL ( Continue = TRUE)
      SAVER "IFF" Previewname "IMAGE"
      IF ( RC ~= 0 ) THEN
       DO
        Text = "Impossible de sauver la preview :" || NL || STRIP( Previewname , B , '"' ) || NL || DiskSpaceError
        OKAYN '"Erreur :"' '"'Text'"' '"Réessayer|Annuler"'
        IF ( RC = 0 ) THEN
         CALL ForceExit
       END
      ELSE
       Continue = TRUE
     END
    END
  END

/*
** Quit.
*/

ForceExit:

 CLOSE_RENDER_SCREEN
 CLEAR_RENDERED
 CLEAR_RAW

 IF ( EXISTS( TempDefaults ) ) THEN
  DO
   LOAD_DEFAULTS TempDefaults
   IF ( RC ~= 0 ) THEN
    OKAY1 "Impossible de restaurer les prefs."
   ADDRESS COMMAND "C:Delete >NIL: FILE" TempDefaults "QUIET"
  END

EXIT 0
RETURN